VERSION 5.00
Object = "{683364A1-B37D-11D1-ADC5-006008A5848C}#1.0#0"; "dhtmled.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmShowReport 
   Caption         =   "Accounting system report"
   ClientHeight    =   6435
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   13365
   Icon            =   "Form2.frx":0000
   LinkTopic       =   "Form2"
   ScaleHeight     =   6435
   ScaleWidth      =   13365
   StartUpPosition =   1  'CenterOwner
   WindowState     =   2  'Maximized
   Begin VB.CommandButton cmdExpenditureSheet 
      Caption         =   "Command4"
      Height          =   375
      Left            =   7800
      TabIndex        =   12
      Top             =   1200
      Visible         =   0   'False
      Width           =   3015
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3480
      Top             =   3480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Print page number"
      Height          =   375
      Left            =   1800
      TabIndex        =   11
      Top             =   0
      Width           =   1815
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Save as Excel"
      Height          =   375
      Left            =   5160
      TabIndex        =   10
      Top             =   0
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Save as HTML"
      Height          =   375
      Left            =   3600
      TabIndex        =   9
      Top             =   0
      Width           =   1455
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GINDO"
      Height          =   375
      Index           =   5
      Left            =   9480
      TabIndex        =   8
      Top             =   0
      Width           =   855
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GVTE"
      Height          =   375
      Index           =   4
      Left            =   8880
      TabIndex        =   7
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GPNH"
      Height          =   375
      Index           =   3
      Left            =   8280
      TabIndex        =   6
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GSGN"
      Height          =   375
      Index           =   2
      Left            =   7680
      TabIndex        =   5
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GDAD"
      Height          =   375
      Index           =   1
      Left            =   7920
      TabIndex        =   4
      Top             =   840
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.CommandButton cmdSheet 
      Caption         =   "GHAN"
      Height          =   375
      Index           =   0
      Left            =   7080
      TabIndex        =   3
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton Command1 
      Height          =   375
      Left            =   0
      Picture         =   "Form2.frx":1CCA
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   0
      Width           =   1695
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "Close"
      Height          =   375
      Left            =   12000
      Picture         =   "Form2.frx":5596
      TabIndex        =   1
      Top             =   0
      Width           =   1095
   End
   Begin DHTMLEDLibCtl.DHTMLEdit DHTMLEdit1 
      Height          =   1695
      Left            =   720
      TabIndex        =   0
      Top             =   600
      Width           =   2895
      ActivateApplets =   0   'False
      ActivateActiveXControls=   0   'False
      ActivateDTCs    =   -1  'True
      ShowDetails     =   0   'False
      ShowBorders     =   0   'False
      Appearance      =   1
      Scrollbars      =   -1  'True
      ScrollbarAppearance=   1
      SourceCodePreservation=   -1  'True
      AbsoluteDropMode=   0   'False
      SnapToGrid      =   0   'False
      SnapToGridX     =   50
      SnapToGridY     =   50
      BrowseMode      =   0   'False
      UseDivOnCarriageReturn=   0   'False
   End
End
Attribute VB_Name = "frmShowReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001

Private Const IE_PROFILE_PATH_NT As String = _
    "Software\Microsoft\Internet Explorer\PageSetup"

Private Const OUTLOOK_ACCOUNT_NAMES_NT As String = _
    "9375CFF0413111d3B88A00104B2A6676"

Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS As Long = 0
Private Const LB_SETTABSTOPS As Long = &H192
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))
                                   
Dim TopMargin As String
Dim TopMarginValue As String
Dim BottomMargin As String
Dim BottomMarginValue As String
Dim RightMargin As String
Dim LeftMargin As String
Dim RightMarginValue As String
Dim LeftMarginValue As String
Dim Footer As String
Dim FooterValue As String
Dim Header As String
Dim HeaderValue As String


Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdSheet_Click(index As Integer)
    'DHTMLEdit1.BrowseMode = Not DHTMLEdit1.BrowseMode
    'DHTMLEdit1.DocumentHTML = " "
    'If Trim(cmdSheet(Index).Tag) <> "" Then
        'LoadDocument (App.Path & "\temp\" & cmdSheet(Index).Caption & ".htm")
         LoadDocument cmdSheet(index).Tag
    'End If
    For I = 0 To cmdSheet.Count - 1
        If I = index Then
            cmdSheet(I).Enabled = False
        Else
            cmdSheet(I).Enabled = True
        End If
    Next I
End Sub

Private Sub Command1_Click()
    '    StopPrinting = False
    '' Set CancelError is True
    'On Error GoTo errhandler
    '
    '    CommonDialog1.PrinterDefault = True
    '    CommonDialog1.CancelError = True
    '
    '    ' Set flags
    '    CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums
    '    CommonDialog1.ShowPrinter
    '
    '    'Printer.Print DHTMLEdit1.Appearance
    '    'Printer.EndDoc
    '    DHTMLEdit1.selp
    '    DHTMLEdit1.PrintDocument
    '    MsgBox "This document has been successfully sent to the printer", vbInformation + vbOKOnly, "Printer"
    '    Exit Sub
    'errhandler:
    '    Select Case err
    '    Case 32755 '  Dialog Cancelled
    '        MsgBox "Print has been cancelled"
    '    Case Else
    '        MsgBox "Unexpected error. Err " & err & " : " & Error
    '    End Select
       
    'get default profile for the current user
    BackupIEProfile
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, TopMargin, "0.750000"
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, BottomMargin, "0.750000"
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, RightMargin, "0.750000"
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, LeftMargin, "0.750000"
    If Check1.Value = 1 Then
        WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Header, "&w&bPage &p"
    Else
        WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Header, ""
    End If
    
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Footer, ""
    
    Printer.Orientation = vbPRORLandscape
    DHTMLEdit1.PrintDocument 1
    'MsgBox "This document has been successfully sent to the printer", vbInformation + vbOKOnly, "Printer"
End Sub

Public Function BackupIEProfile()
    TopMargin = "margin_top"
    BottomMargin = "margin_bottom"
    RightMargin = "margin_right"
    LeftMargin = "margin_left"
    Footer = "footer"
    FooterValue = ""
    Header = "header"
    
    HeaderValue = GetKeyValue(Header)
    FooterValue = GetKeyValue(Footer)
    
    TopMarginValue = GetKeyValue(TopMargin)
    BottomMarginValue = GetKeyValue(BottomMargin)
    
    RightMarginValue = GetKeyValue(RightMargin)
    LeftMarginValue = GetKeyValue(LeftMargin)
End Function
Private Function GetKeyValue(ByVal strKey As String) As String
    Dim hKey As Long
    Dim buff As String
    hKey = OpenRegKey(HKEY_CURRENT_USER, IE_PROFILE_PATH_NT)
    'if valid
    If hKey <> 0 Then
        'get default profile for the current user
        buff = GetRegValue(hKey, strKey)
        Call RegCloseKey(hKey)
    End If
    GetKeyValue = buff
End Function


Private Function GetRegDwordValue(hSubKey As Long, sKeyName As String) As Long
    Dim lpValue As Long   'name of the value to retrieve
    Dim lpcbData As Long  'length of the retrieved value
    'if valid
    If hSubKey <> 0 Then
        lpcbData = 4  '4 bytes for a long
        'return the passed value if present
        If RegQueryValueEx(hSubKey, sKeyName, 0&, 0&, lpValue, lpcbData) = ERROR_SUCCESS Then
            GetRegDwordValue = lpValue
        End If
    End If
End Function

Private Function GetRegBinaryValue(hSubKey As Long, sKeyName As String) As String
    Dim cbData As Long
    Dim buff As String
    Dim dwKeyType As Long
    If RegQueryValueEx(hSubKey, sKeyName, 0&, dwKeyType, ByVal 0&, cbData) = ERROR_SUCCESS Then
        ReDim Res(cbData) As Byte
        If RegQueryValueEx(hSubKey, sKeyName, 0&, dwKeyType, Res(0), cbData) = ERROR_SUCCESS Then
            buff = Res
            If Len(buff) Then
                GetRegBinaryValue = TrimNull(buff)
            Else
                GetRegBinaryValue = "(not defined for this account)"
            End If
        End If  'RegQueryValueEx
    End If  'RegQueryValueEx
    Erase Res()
End Function


Private Function OpenRegKey(ByVal hKey As Long, ByVal lpSubKey As String) As Long
    Dim hSubKey As Long
    If RegOpenKeyEx(hKey, lpSubKey, 0, KEY_READ, hSubKey) = ERROR_SUCCESS Then
        OpenRegKey = hSubKey
    End If
End Function

Private Function TrimNull(startstr As String) As String
   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function


Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
    Dim lpValue As String   'name of the value to retrieve
    Dim lpcbData As Long    'length of the retrieved value
    'if valid
    If hSubKey <> 0 Then
        lpValue = Space$(260)
        lpcbData = Len(lpValue)
        'find the passed value if present
        If RegQueryValueEx(hSubKey, sKeyName, 0&, 0&, ByVal lpValue, lpcbData) = ERROR_SUCCESS Then
            GetRegValue = TrimNull(lpValue)
        End If
    End If
End Function

Public Function IsRegistryEditable() As Boolean
    Dim lValue As Long            ' Variable for value
    Dim sKey As String            ' Key to open
    Dim hKey As Long              ' Handle to registry key
    
    sKey = "Software\Microsoft\Windows\CurrentVersion\Policies\System"
    
    If RegOpenKeyEx(HKEY_CURRENT_USER, sKey, 0, KEY_READ, hKey) <> ERROR_SUCCESS Then
        ' Key does not exist, return True
        IsRegistryEditable = True
    Else
        ' Determine if value exists
        If RegQueryValueEx(hKey, "DisableRegistryTools", 0, REG_DWORD, lValue, Len(lValue)) <> ERROR_SUCCESS Then
            ' value does not exist, return True
            IsRegistryEditable = True
        Else
            ' Return opposite of value (0 = Editable, 1 = Disable)
            IsRegistryEditable = Not CBool(lValue)
        End If
    End If
End Function
Private Sub Command2_Click()
    On Error GoTo L
    CommonDialog1.Filename = "*.htm"
    CommonDialog1.Filter = "HTML (*.htm)|*.html"
    CommonDialog1.ShowSave
    If Len(CommonDialog1.Filename) > 0 Then
        If Len(CommonDialog1.Filename) > 5 Then
            If UCase(Right(CommonDialog1.Filename, 4)) = ".HTM" Or UCase(Right(CommonDialog1.Filename, 5)) = ".HTML" Then
                DHTMLEdit1.SaveDocument CommonDialog1.Filename
                MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
            Else
                DHTMLEdit1.SaveDocument CommonDialog1.Filename & ".htm"
                MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
            End If
        Else
            DHTMLEdit1.SaveDocument CommonDialog1.Filename & ".htm"
            MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
        End If
    Else
        MsgBox "You must be filled in file name!", vbOKOnly + vbInformation, "Export to html"
    End If
    
    Exit Sub
L:
End Sub


Private Sub Command3_Click()
    On Error GoTo L
    CommonDialog1.Filename = "*.xls"
    CommonDialog1.Filter = "Excel (*.xls)"
    CommonDialog1.ShowSave
    If Len(CommonDialog1.Filename) > 0 Then
        If Len(CommonDialog1.Filename) > 4 Then
            If UCase(Right(CommonDialog1.Filename, 4)) = ".XLS" Then
                FileCopy App.Path & "\temp\allsheet.xls", CommonDialog1.Filename
                MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
            Else
                FileCopy App.Path & "\temp\allsheet.xls", CommonDialog1.Filename & ".xls"
                MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
            End If
        Else
            FileCopy App.Path & "\temp\allsheet.xls", CommonDialog1.Filename & ".xls"
            MsgBox "Save is successful", vbInformation + vbOKOnly, "Export"
        End If
    Else
        MsgBox "You must be filled in file name!", vbOKOnly + vbInformation, "Export to excel"
    End If
    Exit Sub
L:
End Sub

Private Sub Form_Load()
    'LoadDocument ("cashflow_GHAN.htm")
    
    '
    '        For i = 0 To cmdSheet.Count - 1
    '            If (cmdSheet(i).Tag) <> "" Then
    '                LoadDocument .cmdSheet(i).Tag
    '                LoadDocument .cmdSheet(i).Tag
    '                cmdSheet(i).Enabled = False
    '                Exit For
    '            End If
    '        Next i
    '    End With
    
    
    ' LoadDocument (App.Path & "\temp\ghan.htm")
    '
    ' LoadDocument (App.Path & "\temp\ghan.htm")
    'LoadDocument (App.Path & "\temp\" & cmdSheet(Index).Caption & ".htm")
    frmShowReport.DHTMLEdit1.Move 25, 400, frmShowReport.ScaleWidth - 25, frmShowReport.ScaleHeight - 600
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, TopMargin, TopMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, BottomMargin, BottomMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, RightMargin, RightMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, LeftMargin, LeftMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Header, HeaderValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Footer, FooterValue
End Sub
Public Function showInfo()
    If cmdExpenditureSheet.Visible = True Then
        LoadDocument App.Path & "\temp\" & cmdExpenditureSheet.Caption & ".htm"
        LoadDocument App.Path & "\temp\" & cmdExpenditureSheet.Caption & ".htm"
        Exit Function
    End If
    For I = 0 To cmdSheet.Count - 1
        If Trim(cmdSheet(I).Tag) <> "" Then
            LoadDocument cmdSheet(I).Tag
            LoadDocument cmdSheet(I).Tag
            cmdSheet(I).Enabled = False
            Exit For
        End If
    Next I
End Function



Private Sub Form_Resize()
    If frmShowReport.ScaleHeight > 0 Then
        frmShowReport.DHTMLEdit1.Move 25, 400, frmShowReport.ScaleWidth - 25, frmShowReport.ScaleHeight - 600
    End If
End Sub

Public Function LoadDocument(ByVal Filename As String)
    'On Error GoTo l
    Dim strContent As String
    If Dir(Filename) = "" Then
       Exit Function
    End If
    
    DHTMLEdit1.DocumentHTML = " "
    DHTMLEdit1.BrowseMode = True
    DHTMLEdit1.DocumentHTML = " "
    
    'Call GetContentHTML(Filename)
    'DHTMLEdit1.LoadURL "file://" & Filename & ".temp"
    DHTMLEdit1.LoadURL "file://" & Filename
    'remove tab
    'DoEvents
    'If Len(Trim(DHTMLEdit1.DocumentHTML)) > 0 Then
    '    DHTMLEdit1.DocumentHTML = Replace$(DHTMLEdit1.DocumentHTML, " <frame src=""" & UCase(Left(Right(Filename, 8), 4)) & "_files/tabstrip.htm"" name=""frTabs"" marginwidth=0 marginheight=0>", "")
    '    DoEvents
    'End If
    DHTMLEdit1.Refresh
    
    'Exit Function
    'l:
    'DHTMLEdit1.DocumentHTML = " "
    'DHTMLEdit1.BrowseMode = Not Me.DHTMLEdit1.BrowseMode
    'DHTMLEdit1.DocumentHTML = " "
    'DHTMLEdit1.LoadURL "file://" & Filename
    'DHTMLEdit1.Refresh
End Function

Private Sub Form_Terminate()
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, TopMargin, TopMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, BottomMargin, BottomMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, RightMargin, RightMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, LeftMargin, LeftMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Header, HeaderValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Footer, FooterValue
End Sub

Private Sub Form_Unload(Cancel As Integer)
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, TopMargin, TopMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, BottomMargin, BottomMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, RightMargin, RightMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, LeftMargin, LeftMarginValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Header, HeaderValue
    WriteRegValue HKEY_CURRENT_USER, IE_PROFILE_PATH_NT, Footer, FooterValue
End Sub
